home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / MM150.ZIP;1 / BASIC.SCR < prev    next >
Encoding:
Text File  |  1992-12-24  |  3.5 KB  |  133 lines

  1. Procedure Rng_Init;
  2. Begin
  3.   OUTPUT_DEVICE:= Pad('CON',4,RIGHT);
  4.   LINES_PER_PAGE:= FStr(Valu('60'),3,0);
  5. End;
  6.  
  7. Procedure Rng_Dsp;
  8. Begin
  9.   Dsp_Fld(18,1,OUTPUT_DEVICE,_Ch,'4U',0,0,_AV,RW.WA[1]);
  10.   Dsp_Fld(18,2,LINES_PER_PAGE,_Num,'3#',0,0,_AV,RW.WA[1]);
  11.   IODEV := Strip(OUTPUT_DEVICE);
  12.   PageLength := IVal(LINES_PER_PAGE);
  13. End;
  14.  
  15. Procedure Rng_Edt;
  16. Var
  17.   Abort,
  18.   NoneEdited,
  19.   Bypass,
  20.   Edited,
  21.   Finished,
  22.   Fld_In_Range : Boolean;
  23.   Last_Fld     : Integer;
  24.   EdtWin       : WinPtr;
  25.  
  26. Function SkipField(FNum : Integer) : Boolean;
  27. Var TB : Boolean;
  28. Begin
  29.   TB := False;
  30.   case FNum of
  31.     0 : begin end;
  32.   end;
  33.   SkipField := TB;
  34. End;
  35.  
  36. Function Chk_Fld(ChkNum : Integer) : Boolean;
  37. Var
  38.   EStr : String;
  39. Begin
  40.   EStr := '';
  41.   case ChkNum of
  42.     1 : if not(Choice('CON |PRN |LPT1|LPT2',OUTPUT_DEVICE)) then
  43.     EStr := Choose('CON |PRN |LPT1|LPT2','',OUTPUT_DEVICE);
  44.     2 : if not(( Valu(LINES_PER_PAGE) >=6) and ( Valu(LINES_PER_PAGE) <= 100)) then
  45.     EStr := 'Please enter a Page Length of between 6 and 100 Lines.';
  46.   end;  { case ChkNum }
  47.   if (EStr <> '') then begin
  48.     if (EStr <> LSC_BaseError) then begin
  49.       Audible(Error);
  50.       Message(RW.WA[1],EStr);
  51.     end;
  52.     Chk_Fld := False;
  53.   end
  54.   else Chk_Fld := True;
  55. End;
  56.  
  57. Procedure Edt_N_Chk(x,y,l,a:Byte; H : WinPtr; Var Fld:String; Typ:Char; Pic:String; Fldno : Integer);
  58. Begin
  59.   if Not(SkipField(FldNo)) then begin
  60.     repeat
  61.       if not Bypass then begin
  62.         Edt_Fld(x,y,Fld,Typ,Pic,l,a,RW.WA[1]);
  63.         NoneEdited := False;
  64.         Edited := True;
  65.         Abort := False;
  66.         if (ExitCode = HlpKey) then DispHelp(h);
  67.         if Custom_Key(1,1,Fldnum,ExitCode) then ExitCode := QitKey;
  68.       end;
  69.       if not(ExitCode in [QitKey,UArr,HlpKey]) then begin
  70.         Fld_In_Range := Chk_Fld(Fldno);
  71.         Dsp_Fld(x,y,Fld,Typ,Pic,0,l,a,RW.WA[1]);
  72.         if not Fld_In_Range then begin
  73.           FldNum := Fldno;
  74.           Bypass := False;
  75.         end;
  76.       end;
  77.     until Fld_In_Range or (ExitCode in [QitKey,UArr]);
  78.     Message(Nil,'');
  79.   end;
  80. End;
  81.  
  82. Procedure OpenEdtMnu;
  83. Var TS : String;
  84. Begin
  85.   TS := _EdtHelp;
  86.   if OpenWin(0,ScrWid-Length(TS)+1,ScrHgt,Length(TS),1,$4F,$4F,0,#0'ø≥Ÿƒ¿≥⁄',TopCnt,'') then begin
  87.     EdtWin := CurWin;
  88.     WriteWXY(TS,0,1,1,EdtWin);
  89.     HideWin(T_On,EdtWin);
  90.   end
  91.   else EdtWin := Nil;
  92. End;
  93.  
  94. Begin
  95.   OpenEdtMnu;
  96.   Attrib := _AV;
  97.   ExitCode := Nul;
  98.   Abort := True;
  99.   Bypass := False;
  100.   FldNum := 1;
  101.   Finished := False;
  102.   repeat
  103.     if FldNum = 1 then NoneEdited := True;
  104.     if (Last_Fld = FldNum) and Not(Edited) then Inc(FldNum);
  105.     Last_Fld := FldNum;
  106.     Edited :=  False;
  107.     case FldNum of
  108.         1 : Edt_N_Chk(18,1,0,0,Nil,OUTPUT_DEVICE,_Ch,'4U',1);
  109.         2 : Edt_N_Chk(18,2,0,0,Nil,LINES_PER_PAGE,_Num,'3#',2);
  110.         3 : begin
  111.         IODEV := Strip(OUTPUT_DEVICE);
  112.         end;
  113.         4 : begin
  114.         PageLength := IVal(LINES_PER_PAGE);
  115.         end;
  116.         else if NoneEdited then begin
  117.           Finished := true;
  118.           if Abort then begin
  119.             ExitCode := QitKey;
  120.             DBErrM(_NoneEdited);
  121.           end
  122.         end
  123.         else if ExitCode = XeptKey then Finished := True else FldNum := 0;
  124.     end;  { case Fldnum }
  125.     if Bypass or not(Edited) then
  126.       if _Upward and (FldNum > 1) then Dec(Fldnum) else Inc(Fldnum);
  127.     if (ExitCode = XeptKey) then Bypass := True;
  128.     if (ExitCode = QitKey) then Finished := True;
  129.     if FldNum > Last_Fld then _Upward := False;
  130.   until Finished;
  131.   if EdtWin <> Nil then CloseWin(EdtWin);
  132. End;
  133.